home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / ada / gnat1792.zip / gnat179b / t-adainc / a-stwiun.adb < prev    next >
Text File  |  1994-05-19  |  17KB  |  574 lines
  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                         GNAT RUNTIME COMPONENTS                          --
  4. --                                                                          --
  5. --           A D A . S T R I N G S . W I D E _ U N B O U N D E D            --
  6. --                                                                          --
  7. --                                 B o d y                                  --
  8. --                                                                          --
  9. --                            $Revision: 1.3 $                              --
  10. --                                                                          --
  11. --           Copyright (c) 1992,1993,1994 NYU, All Rights Reserved          --
  12. --                                                                          --
  13. -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  14. -- terms of the  GNU General Public License as published  by the Free Soft- --
  15. -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  16. -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  17. -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  18. -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  19. -- for  more details.  You should have  received  a copy of the GNU General --
  20. -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  21. -- to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. --
  22. --                                                                          --
  23. ------------------------------------------------------------------------------
  24.  
  25. --  Note: This code is derived from the ADAR.CSH public domain Ada 83
  26. --  version of Strings.Bounded of the Appendix C string handling packages.
  27.  
  28.  
  29. with Ada.Strings.Wide_Fixed;
  30. with Ada.Strings.Wide_Search;
  31. with Unchecked_Deallocation;
  32.  
  33. package body Ada.Strings.Wide_Unbounded is
  34.  
  35.    -----------------------
  36.    -- Local Subprograms --
  37.    -----------------------
  38.  
  39.    procedure Free (Handle : in out Unbounded_Wide_String);
  40.    --  Free an unbounded string using unchecked deallocation. This is used
  41.    --  only internally to this package by those routines which must be sure
  42.    --  to free a string before reassigning it. This is a temporary kludge
  43.    --  to make up for the fact that we do not have finalization yet! ???
  44.  
  45.    ---------
  46.    -- "=" --
  47.    ---------
  48.  
  49.    function "="  (Left, Right : in Unbounded_Wide_String) return Boolean is
  50.    begin
  51.       return Left.Reference.all = Right.Reference.all;
  52.    end "=";
  53.  
  54.    ---------
  55.    -- "<" --
  56.    ---------
  57.  
  58.    function "<"  (Left, Right : in Unbounded_Wide_String) return Boolean is
  59.    begin
  60.       return Left.Reference.all < Right.Reference.all;
  61.    end "<";
  62.  
  63.    ----------
  64.    -- "<=" --
  65.    ----------
  66.  
  67.    function "<=" (Left, Right : in Unbounded_Wide_String) return Boolean is
  68.    begin
  69.       return Left.Reference.all <= Right.Reference.all;
  70.    end "<=";
  71.  
  72.    ---------
  73.    -- ">" --
  74.    ---------
  75.  
  76.    function ">"  (Left, Right : in Unbounded_Wide_String) return Boolean is
  77.    begin
  78.       return Left.Reference.all > Right.Reference.all;
  79.    end ">";
  80.  
  81.    ----------
  82.    -- ">=" --
  83.    ----------
  84.  
  85.    function ">=" (Left, Right : in Unbounded_Wide_String) return Boolean is
  86.    begin
  87.       return Left.Reference.all >= Right.Reference.all;
  88.    end ">=";
  89.  
  90.    ---------
  91.    -- "*" --
  92.    ---------
  93.  
  94.    function "*" (Left : in Natural; Right : in Wide_Character)
  95.      return Unbounded_Wide_String
  96.    is
  97.       Result : Unbounded_Wide_String :=
  98.                  (Reference => new Wide_String (1 .. Left));
  99.  
  100.    begin
  101.       Result.Reference.all := (1 .. Left => Right);
  102.       return Result;
  103.    end "*";
  104.  
  105.    function "*" (Left : in Natural; Right : in Wide_String)
  106.      return Unbounded_Wide_String
  107.    is
  108.       Result : Unbounded_Wide_String :=
  109.          (Reference => new Wide_String (1 .. Left * Right'Length));
  110.  
  111.    begin
  112.       for I in 1 .. Left loop
  113.          Result.Reference.all
  114.            (Right'Length * I - Right'Length + 1 .. Right'Length * I) := Right;
  115.       end loop;
  116.  
  117.       return Result;
  118.    end "*";
  119.  
  120.    function "*" (Left : in Natural; Right : in Unbounded_Wide_String)
  121.      return Unbounded_Wide_String
  122.    is
  123.       R_Length : constant Integer := Right.Reference.all'Length;
  124.       Result   : Unbounded_Wide_String :=
  125.         (Reference =>
  126.           new Wide_String (1 .. Left * Right.Reference.all'Length));
  127.  
  128.    begin
  129.       for I in 1 .. Left loop
  130.          Result.Reference.all (R_Length * I - R_Length + 1 .. R_Length * I) :=
  131.            Right.Reference.all;
  132.       end loop;
  133.  
  134.       return Result;
  135.    end "*";
  136.  
  137.    ---------
  138.    -- "&" --
  139.    ---------
  140.  
  141.    function "&" (Left, Right : in Unbounded_Wide_String)
  142.      return Unbounded_Wide_String
  143.    is
  144.       L_Length : constant Integer := Left.Reference.all'Length;
  145.       R_Length : constant Integer := Right.Reference.all'Length;
  146.       Length   : constant Integer :=  L_Length + R_Length;
  147.       Result   : Unbounded_Wide_String :=
  148.                    (Reference => new Wide_String (1 .. Length));
  149.  
  150.    begin
  151.       Result.Reference.all (1 .. L_Length)          := Left.Reference.all;
  152.       Result.Reference.all (L_Length + 1 .. Length) := Right.Reference.all;
  153.       return Result;
  154.    end "&";
  155.  
  156.    function "&" (Left : in Unbounded_Wide_String; Right : Wide_String)
  157.      return Unbounded_Wide_String
  158.    is
  159.       L_Length : constant Integer := Left.Reference.all'Length;
  160.       Length   : constant Integer := L_Length +  Right'Length;
  161.       Result   : Unbounded_Wide_String :=
  162.                    (Reference => new Wide_String (1 .. Length));
  163.  
  164.    begin
  165.       Result.Reference.all (1 .. L_Length)          := Left.Reference.all;
  166.       Result.Reference.all (L_Length + 1 .. Length) := Right;
  167.       return Result;
  168.    end "&";
  169.  
  170.    function "&" (Left : in Wide_String; Right : Unbounded_Wide_String)
  171.      return Unbounded_Wide_String
  172.    is
  173.       R_Length : constant Integer := Right.Reference.all'Length;
  174.       Length   : constant Integer := Left'Length + R_Length;
  175.       Result   : Unbounded_Wide_String :=
  176.                    (Reference => new Wide_String (1 .. Length));
  177.  
  178.    begin
  179.       Result.Reference.all (1 .. Left'Length)          := Left;
  180.       Result.Reference.all (Left'Length + 1 .. Length) := Right.Reference.all;
  181.       return Result;
  182.    end "&";
  183.  
  184.    function "&" (Left : in Unbounded_Wide_String; Right : Wide_Character)
  185.      return Unbounded_Wide_String
  186.    is
  187.       Length : constant Integer := Left.Reference.all'Length + 1;
  188.       Result : Unbounded_Wide_String :=
  189.                  (Reference => new Wide_String (1 .. Length));
  190.  
  191.    begin
  192.       Result.Reference.all (1 .. Length - 1) := Left.Reference.all;
  193.       Result.Reference.all (Length)          := Right;
  194.       return Result;
  195.    end "&";
  196.  
  197.    function "&" (Left : in Wide_Character; Right : Unbounded_Wide_String)
  198.      return Unbounded_Wide_String
  199.    is
  200.       Length : constant Integer := Right.Reference.all'Length + 1;
  201.       Result : Unbounded_Wide_String :=
  202.                  (Reference => new Wide_String (1 .. Length));
  203.  
  204.    begin
  205.       Result.Reference.all (1)           := Left;
  206.       Result.Reference.all (2 .. Length) := Right.Reference.all;
  207.       return Result;
  208.    end "&";
  209.  
  210.    -----------
  211.    -- Count --
  212.    -----------
  213.  
  214.    function Count (Source   : in Unbounded_Wide_String;
  215.                    Pattern  : in Wide_String;
  216.                    Mapping  : in Wide_Maps.Wide_Character_Mapping
  217.                                 := Wide_Maps.Identity)
  218.    return Natural is
  219.    begin
  220.       return Wide_Search.Count (Source.Reference.all, Pattern, Mapping);
  221.    end Count;
  222.  
  223.    function Count (Source   : in Unbounded_Wide_String;
  224.                    Pattern  : in Wide_String;
  225.                    Mapping  : in Wide_Maps.Wide_Character_Mapping_Function)
  226.    return Natural is
  227.    begin
  228.       return Wide_Search.Count (Source.Reference.all, Pattern, Mapping);
  229.    end Count;
  230.  
  231.    function Count (Source   : in Unbounded_Wide_String;
  232.                    Set      : in Wide_Maps.Wide_Character_Set)
  233.    return Natural is
  234.    begin
  235.       return